EnigmA Amiga Run 1995 October/EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso/Aminet/comm/fido/RFS275.lha/rexx/RFH.src

Text File | 1995-04-15 | 25KB | 592 lines

Options Results
template="PORT/A,LINE/A,CFG/K";cfg=""
if arg()=0 then do;say template;exit;end
parse arg args
if ~ReadArgs(args,template) then do;say Fault(RC,template);exit 10;end
else do
  LG=lower(port)'wpl';line=strip(line)
  if cfg="" then cfg="CFG:RFH.CFG"
end
sv="v"right(v,5);app="RFH "sv;MP="RFH"line;mport=upper(port)||line
Options failat 99
numeric digits 14
Signal On Syntax
signal on halt
cr='0D'x;lf="0A"x;LBUF="";ABUF="";MBUF=""
HydraReq='T:HydraReq.'||line
if showlist('P',MP) then do;address LOGPROC 'Putlog 'LG time() line MP': 'app' already open';exit 10;end
if ~openport(MP) then do;address LOGPROC 'Putlog 'LG time() line MP': Could not open 'MP', quitting';exit 10;end
call setconfig()
r.1='Unregistered Node';r.2='Excluded Node';r.3='Excluded Point';r.4='Unlisted System'
e.1='Duplicate Request Ignored';e.2='File Not Found';e.3='Password Missing or Invalid'
e.4='File Not Available On This System';e.5='Request Exceeded Maximum Requests';e.6='Request Exceeded Byte count'
address LOGPROC 'Putlog 'LG time() line app 'Ready'
quitflag=0
do forever
  drop p entry RFunc cmdword
  if quitflag=1 then leave
  t=waitpkt(MP)
  do ff=1
    p=getpkt(MP)
    if c2d(p)=0 then leave ff
    RFunc=getarg(p)
    cmdword=(upper(word(RFunc,1)))
    if cmdword="REQ" | cmdword="RFHCFG" | cmdword="RFHSHOW" | cmdword="RFHEXIT" then call reply(p,0)
    else call reply(p,5)
    select
      when cmdword="REQ" then do
        Parse var RFunc junk' 'baud H_A Infile Listed FNC HYD R_A R_S
        xfq_site_object=XfqGetAddress(R_A)
        if ~XfqHoldMailer(xfq_site_object) then do
          address LOGPROC 'Putlog 'LG time() line MP 'HOLD Failed:'XFQERRORMSG R_A
          drop XFQERRORCODE XFQERRORMSG
        end;else do
          call do_req()
          drop junk Baud H_A Infile Listed FNC HYD R_A R_S
          drop NumRequested ReqName SendFname Fname Fsize Fdesc Mname Password Update UDT UpDt Jdate
          drop Num ReqCount SentCount SearchResult FirstDate NumReqs ReqFiles Sent ReqBytes TBytes LastBytes UserCalls
          drop file sendas
        end
      end
      when cmdword="RFHEXIT" then quitflag=1
      when cmdword="RFHCFG" then call setconfig()
      when cmdword="RFHSHOW" then call showconfig()
      otherwise nop
    end
  end
end
address LOGPROC 'Putlog 'LG time() line MP 'port closed'
exit

do_req:
parse var R_A hisaddress.domain '#' hisaddress.zone ':' hisaddress.net '/' hisaddress.node '.' hisaddress.point
R_S=strip(R_S);if R_S="" then R_S="Unknown Sysop"
address LOGPROC 'Putlog 'LG time() Line app 'Serving 'R_S' of 'R_A' on 'MPORT' FNC:'fnc' HYD:'hyd
HBUF="";LBUF="";ABUF="";MBUF="";pbuf="";tlist="T:RFH_t"Line;ulist="T:RFH_u"Line;a=0;b=0;i=0;x=0;Sent=0;TBytes=0
FreqLst=SFreqLst
LBUF=LBUF||date() time()' RFH Serving 'R_S' of 'R_A' on 'MPORT||lf
parse var H_A myaddress.domain '#' myaddress.zone ':' myaddress.net '/' myaddress.node '.' myaddress.point
if HYD=1 then SessMaxReqNames=3;else SessMaxReqNames=MaxReqNames

if ~ReqPoint & (hisaddress.point > "0") then return badsite(r.3,R_A,R_S)
else if ~ReqUnlisted & ~Listed then return badsite(r.4,R_A,R_S)

if INCLUDE.0~=0 then do zz=1 to INCLUDE.0
  validnode=0
  if matchpattern(Include.zz,R_A,"N") then do
    validnode=1
    leave
  end
  if ~validnode then return badsite(r.1,R_A,R_S)
end
if EXCLUDE.0~=0 then do zz=1 to EXCLUDE.0
  if matchpattern(Exclude.zz,R_A,"N") then return badsite(r.2,R_A,R_S)
end
if PRIVLEDGED.0~=0 then do zz=1 to PRIVLEDGED.0
  if matchpattern(Privledged.zz,R_A,"N") then do
    LBUF=LBUF||date() time() Line R_A 'granted privledged access'lf
    if exists(PFreqLst) then FreqLst=PFreqLst
    else LBUF=LBUF||date() time() Line 'Cannot find 'PFreqLst||lf
  end
end
AcctFile=AcctPath||translate(R_A,'...','#:/')
if exists(AcctFile) then do
  call open('Acct',AcctFile,'R')
  FirstDate=readln('Acct')
  LastDate=readln('Acct')
  NumReqs=readln('Acct')
  ReqFiles=readln('Acct')
  ReqBytes=readln('Acct')
  LastBytes=readln('Acct')
  UserCalls=readln('Acct')
  call close('Acct')
  if LastDate~=Date() then LastBytes=0
  UserCalls=UserCalls+1
end;else do
  FirstDate=Date();LastDate=Date();NumReqs=0;ReqFiles=0;ReqBytes=0;LastBytes=0;UserCalls=0
end
SessBytes=MaxBytes
if LIMITED.0~=0 then do zz=1 to LIMITED.0
  if matchpattern(word(Limited.zz,1),R_A,"N") then do
    SessBytes=word(Limited.zz,2)
    address LOGPROC 'Putlog 'LG time() Line "Reducing Max Bytes for LIMITED site to "SessBytes
    LBUF=LBUF||date() time() Line' Reducing Max Bytes to 'SessBytes' for 'R_S' of 'R_A' -> Limited Node!'lf
    leave
  end
end

NumRequested=1
if ~open(RQ,Infile,'R') then do
  address LOGPROC 'Putlog 'LG time() Line "Unable to read "Infile
  LBUF=LBUF||date() time() Line Infile' from 'R_S' of 'R_A' -> Not Found'lf
  call end_session()
  return
end
do while ~eof(RQ)
  FName.NumRequested=upper(strip(readln(RQ),"B",CR))
  MName.NumRequested=""
  if left(FName.NumRequested,1)=";" | left(FName.NumRequested,3)="---" then iterate
  if right(FName.NumRequested,1)=D2C('13') then FName.NumRequested=left(FName.NumRequested,Length(FName.NumRequested)-1)
  if length(FName.NumRequested) < 1 then leave
  Update.NumRequested=""
  Password.NumRequested=""
  if words(FName.NumRequested) > 1 then do
    if left(word(FName.NumRequested,2),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,2),2)
    if left(word(FName.NumRequested,2),1)="+" then Update.NumRequested=Word(FName.NumRequested,2)
    else if left(word(FName.NumRequested,2),1)="-" then Update.NumRequested=Word(FName.NumRequested,2)
    else if words(FName.NumRequested)=3 then do
      if left(word(FName.NumRequested,3),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,3),2)
      if left(word(FName.NumRequested,3),1)="+" then Update.NumRequested=Word(FName.NumRequested,3)
      else if left(word(FName.NumRequested,3),1)="-" then Update.NumRequested=Word(FName.NumRequested,3)
    end
    FName.NumRequested=word(FName.NumRequested,1)
  end
  NumRequested=NumRequested+1
end
call close(RQ)
NumRequested=NumRequested-1
call FindRequests
do a=1 to NumRequested
  if (SessMaxReqNames>0 & a>SessMaxReqNames) | SendFName.a.SentFiles=0 then SendFName.a.SentFiles=1
  do b=1 to SendFName.a.SentFiles
    if SendFName.a.b="Duplicate Request Ignored" then do;call RspErr(e.1,a,FName.a);iterate;end
    else if SendFName.a.b="File Not Found" then do;call RspErr(e.2,a,FName.a);iterate;end
    else if SendFName.a.b="Bad Password" then do;call RspErr(e.3,a,FName.a,Password.a);iterate;end
    else if SendFName.a.b="File Not Available" then do;call RspErr(e.4,a,FName.a,Password.a);iterate;end
    else if SendFName.a.b="Too Many Requests" | (SessMaxReqNames>0 & a>SessMaxReqNames) then do;call RspErr(e.5,a,FName.a);iterate;end
    else if SendFName.a.b="Too Many Bytes" then do;call RspErr(e.6,a,FName.a);iterate;end
    else if SubWord(SendFName.a.b,1,3)="Update request failed:" then do
      MBUF=MBUF||'Request Number 'a  'Requested: 'FName.a||cr'Date : 'JDate.a.b||cr'Error: 'SendFName.a.b||cr||cr
      LBUF=LBUF||date() time()' 'FName.a' -=> Error: 'SendFName.a.b||lf
      iterate
    end;else do
      Sent=Sent+1
      if MName.a.b~="" then do
        MBUF=MBUF||'Request Number 'a  'Requested: 'FName.a||' Sent:'MName.a.b||cr'Size : 'FSize.a.b' bytes'cr'Desc : 'FDesc.a.b||cr||cr
        LBUF=LBUF||date() time()' 'FName.a '['MName.a.b'] ('FSize.a.b' bytes)'lf
      end;else do
        MBUF=MBUF||'Request Number 'a  'Requested: 'FName.a||cr'Size : 'FSize.a.b' bytes'cr'Desc : 'FDesc.a.b||cr||cr
        LBUF=LBUF||date() time()' 'FName.a' ('FSize.a.b' bytes)'lf
      end
    end
  end
end
if (SessMaxReqNames>0) & (NumRequested>SessMaxReqNames) then MBUF=MBUF||'Remaining Requests skipped for exceeding request limits'cr
call writepkt(MBUF)
if SysopReport then call writepkt(MBUF,'S')
drop MBUF
LBUF=LBUF||date() time()' Sending 'Sent' file(s), 'TBytes' bytes this request'lf||date() time()' Totals: 'NumReqs+1' request(s) for 'ReqFiles+Sent' file(s) ('ReqBytes+TBytes' bytes)'lf
ABUF=ABUF||FirstDate||lf||Date()||lf||NumReqs+1||lf||ReqFiles+Sent||lf||ReqBytes+TBytes||lf||LastBytes+TBytes||lf||UserCalls||lf

if HYD then do
if open(H,HydraReq,'A') then address LOGPROC 'PutLog 'LG time() Line MP "Appending to "HydraReq
else do
  if open(H,HydraReq,'W') then address LOGPROC 'PutLog 'LG time() Line MP "Creating "HydraReq
  else do
    address LOGPROC 'PutLog 'LG time() Line MP "Unable to write "HydraReq
    call end_session()
    return
  end
end
call writech(H,Hbuf);call close(H);drop Hbuf
call SetClip('HYDREQ'line,"OK")
end
call end_session()
Return

FindRequests:
Num=NumRequested
if (SessMaxReqNames~=0) & (NumRequested>SessMaxReqNames) then Num=SessMaxReqNames
LBUF=LBUF||date() time()' Using 'FreqLst||lf
do ReqCount=1 to Num
  address LOGPROC 'PutLog 'LG time() Line MP "Searching for Req:"ReqCount":"FName.ReqCount" in "FREQLST
  SentCount=1;notfound=1
  SendFName.ReqCount.SentCount="File Not Found"

  if ReqCount>1 then do
    dupe=0
    do fz=1 to ReqCount-1
      if upper(Fname.ReqCount)=upper(Fname.fz) then dupe=1
    end
    if dupe then do
      SendFName.ReqCount.SentCount="Duplicate Request Ignored"
      address LOGPROC 'PutLog 'LG time() Line MP "Req:"ReqCount":"FName.ReqCount SendFName.ReqCount.SentCount
      Iterate
    end
  end
  sopt=""
  if SortedLst then sopt="-s"
  if MatchFirst then address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount '-o' sopt
  else address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount sopt
  call open('tq',tlist,'r')
  do while ~eof('tq')
    SearchResult=strip(readln('tq'))
    if SearchResult="" then Iterate
    if SearchResult="!@ No match found" then do
      SendFName.ReqCount.SentCount="File Not Found"
      Leave
    end
    if MatchFirst then do
      call sendifok
      Leave
    end
    call sendifok
    SentCount=SentCount+1
    if MultiMagic | ~MatchFirst then Iterate;else Leave
  end
  call close('tq');call delete(tlist)
  if SentCount=0 then SendFname.ReqCount.SentFiles=1
  else if SentCount > 1 then SendFname.ReqCount.SentFiles=SentCount-1
  else SendFname.ReqCount.SentFiles=SentCount
end
Return

sendifok:
sendit=1
if index(SearchResult,'!')=0 then SendFname.ReqCount.SentCount=upper(subword(SearchResult,2))
else do
  if upper(Password.ReqCount)~=strip(upper(delstr(word(SearchResult,2),1,1))) then do
    SendFName.ReqCount.SentCount="Bad Password"
    sendit=0
  end;else SendFname.ReqCount.SentCount=upper(subword(SearchResult,3))
end
if ~sendit then return sendit
if ~exists(SendFName.ReqCount.SentCount) then do
  SendFName.ReqCount.SentCount="File Not Available"
  sendit=0
end;else do
  FName.ReqCount.SentCount=get_fn(SendFName.ReqCount.SentCount)
  filestats=statef(SendFName.ReqCount.SentCount)
  FSize.ReqCount.SentCount=word(filestats,2)
  TBytes=TBytes+FSize.ReqCount.SentCount
  if SessBytes>0 & (TBytes>SessBytes) then do
    SendFName.ReqCount.SentCount="Too Many Bytes"
    TBytes=TBytes-FSize.ReqCount.SentCount
    sendit=0
  end
  if (MaxDaily > 0) & (TBytes+LastBytes > MaxDaily) then do
    SendFName.ReqCount.SentCount="Exceeded Daily Limit"
    TBytes=TBytes-FSize.ReqCount.SentCount
    sendit=0
  end
  FDesc.ReqCount.SentCount=get_fd(SendFName.ReqCount.SentCount,filestats)
  if FDesc.ReqCount.SentCount="" then FDesc.ReqCount.SentCount="Sorry, description is unavailable"

  if Update.ReqCount ~="" then do
    UDT.ReqCount=left(Update.ReqCount,1)
    if substr(Update.ReqCount,2,1)="U" then do
      Update.ReqCount=SubStr(Update.ReqCount,3)
      UDT.Human=1
    end;else do
      Update.ReqCount=SubStr(Update.ReqCount,2)
      UDT.Human=0
    end
    if UDT.Human then do
      if length(strip(Update.ReqCount)) >6 then do
        cktime=1
        cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D%T" TO 'ulist
      end;else do
        cktime=0
        cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D" TO 'ulist
      end
      Address Command cmd
      call open('UFile',ulist,'R')
      UpDt.ReqCount.SentCount=readln('UFile')
      call close('UFile')
      call Delete(ulist)
      if cktime then UpDt.ReqCount.SentCount=space(translate(UpDt.ReqCount.SentCount,"",":"),0)
      Mon=right('00'||(pos(substr(UpDt.ReqCount.SentCount,4,3),'JanFebMarAprMayJunJulAugSepOctNovDec')+2)/3,2)
      if cktime then Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)||right(UpDt.ReqCount.SentCount,8)
        else Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)
    end;else do
      x=statef(SendFName.ReqCount.SentCount)
      JDate.ReqCount.SentCount=(86400*365*8)+(2*86400)+(((word(x,5))*86400)+(word(x,6)*60))
    end
    if (UDT.ReqCount="+") & (JDate.ReqCount.SentCount < Update.ReqCount) then do
      SendFName.ReqCount.SentCount="Update request failed: File older than requested."
      sendit=0
    end
    if (UDT.ReqCount="-") & (JDate.ReqCount.SentCount > Update.ReqCount) then do
      SendFName.ReqCount.SentCount="Update request failed: File newer than requested."
      sendit=0
    end
  end
end
if sendit then do
  Mname.ReqCount.SentCount=get_fn(SendFname.ReqCount.SentCount)
  if Fname.ReqCount=Mname.ReqCount.SentCount then Mname.ReqCount.SentCount=""
  sendas=get_fn(SendFName.ReqCount.SentCount)
  if FNC then do
    mBUF=mBUF||cr'FileName Requested with EMSI FNC flag:'sendas||cr
    lastp=lastpos('.',sendas)
    if pos('.',sendas)~=lastp then sendas=space(overlay('.',translate(sendas,' ','.'),lastp,1),0)
    sendas=compress(sendas,xrange('20'x,'2d'x)'2f'x||xrange('3a'x,'40'x)xrange('5b'x,'60'x)xrange('7b'x,'7f'x))
    parse var sendas n '.' xx
    sendas=strip(left(n,8))"."strip(left(xx,3))
    drop n xx
    mBUF=mBUF||cr'FileName Converted per EMSI FNC flag:'sendas||cr
  end
  call queueadd(SendFName.ReqCount.SentCount,sendas,4)
end
return sendit

writepkt:
sysrpt=arg(2)=="S"
magicnum=x2d(time('s'))+randu(x2d(Pragma('ID')))+(randu(x2d(time('s')))*999999)+(random()*1000000)
serial=reverse(right("0000"x||c2x(magicnum),8))
if ~sysrpt then packet_name="T:"serial".PKT"
else do
  packet_name=get_path(Infile)||serial".PKT"
  myaddress.imp_point=1
end

d=date("S");t=time("N");parse var t hh":"mm":"ss
yr=reverse(right("00"x||d2c(left(d,4)),2));mh=reverse(right("00"x||d2c((substr(d,5,2)-1)),2));dy=reverse(right("00"x||d2c(substr(d,7,2)),2))
hr=reverse(right("00"x||d2c(hh),2));mn=reverse(right("00"x||d2c(mm),2));sc=reverse(right("00"x||d2c(ss),2))

zo=reverse(right("00"x||d2c(myaddress.zone),2));ndo=reverse(right("00"x||d2c(myaddress.node),2))
nto=reverse(right("00"x||d2c(myaddress.net),2));po=reverse(right("00"x||d2c(myaddress.point),2))
if sysrpt then do
 po=reverse(right("00"x||d2c(myaddress.imp_point),2))
 zd=reverse(right("00"x||d2c(myaddress.zone),2));ndd=reverse(right("00"x||d2c(myaddress.node),2))
 ntd=reverse(right("00"x||d2c(myaddress.net),2));pd=reverse(right("00"x||d2c(myaddress.point),2))
end;else do
 zd=reverse(right("00"x||d2c(hisaddress.zone),2));ndd=reverse(right("00"x||d2c(hisaddress.node),2))
 ntd=reverse(right("00"x||d2c(hisaddress.net),2));pd=reverse(right("00"x||d2c(hisaddress.point),2))
end
pbuf=ndo||ndd||yr||mh||dy||hr||mn||sc||copies("00"x,2)||"0200"x||nto||ntd||"DA"x||d2c(substr(sv,2,2))||copies("00"x,8)
pbuf=pbuf||zo||zd||copies("00"x,2)||reverse(right("01"x||"00"x,2))||"00"x||d2c(substr(sv,5,2))||reverse(right("00"x||"01"x,2))
pbuf=pbuf||zo||zd||po||pd||"ROOF"||"0200"x||ndo||ndd||nto||ntd||"11000000"x||left(date(),6) right(date(),2) "" right("0"||time(),8)||"00"x

if sysrpt then pbuf=pbuf||"SYSOP"||"00"x||app||"00"x||"Report for "R_S" at "R_A||"00"x
else do
  pbuf=pbuf||R_S||"00"x||app||"00"x||"Results of your file request"||"00"x
  if myaddress.zone~=hisaddress.zone then pbuf=pbuf||"01"x||"INTL" hisaddress.zone":"hisaddress.net"/"hisaddress.node myaddress.zone":"myaddress.net"/"myaddress.node||cr
  else pbuf=pbuf||"01"x||"MSGTO:" hisaddress.zone":"hisaddress.net"/"hisaddress.node||cr
  if myaddress.point~=0 then pbuf=pbuf||"01"x||"FMPT" myaddress.point||cr;if hisaddress.point~=0 then pbuf=pbuf||"01"x||"TOPT" hisaddress.point||cr
  pbuf=pbuf||"01"x||"MSGID: "myaddress.zone':'myaddress.net'/'myaddress.node'.'myaddress.point' 'd2x((date('I') * 86400)+time("S")[phone]) ||cr
end
pbuf=pbuf||"01"x||"PID: "app||cr

if ~sysrpt then do
  pbuf=pbuf||cr"    Presenting "app", the WPL File Request ARexx Function Host"cr||cr
  pbuf=pbuf||cr'The following are the results of your File Request:'cr||cr||arg(1)||cr
  pbuf=pbuf||cr'Sending 'Sent' file(s), 'TBytes' bytes this request.'cr||cr'You have made a total of 'NumReqs+1' FileRequest(s) for 'ReqFiles+Sent' files ('ReqBytes+TBytes' bytes)'cr
  pbuf=pbuf||cr'Files were requested from 'app' on 'H_A||cr
end;else do
  pbuf=pbuf||cr' Inbound File Request Tracking'||cr||cr
  pbuf=pbuf||cr'   Address                :'right_justify(R_A,23)
  pbuf=pbuf||cr'   Sysop                  :'right_justify(R_S,23)
  pbuf=pbuf||cr'   First Call             :'right_justify(Firstdate,23)
  pbuf=pbuf||cr'   Last Call              :'right_justify(LastDate,23)
  pbuf=pbuf||cr'   Number of Requests     :'right_justify(NumReqs+1,23)
  pbuf=pbuf||cr'   Files Transfered       :'right_justify(SENT,23)
  pbuf=pbuf||cr'   Total Files Transfered :'right_justify(ReqFiles+SENT,23)
  pbuf=pbuf||cr'   Bytes Sent This Call   :'right_justify(TBytes,23)
  pbuf=pbuf||cr'   Bytes Sent Last Call   :'right_justify(LastBytes,23)
  pbuf=pbuf||cr'   Total Bytes Sent       :'right_justify(ReqBytes+Tbytes,23)
  pbuf=pbuf||cr'   Number of Sessions     :'right_justify(Usercalls,23)
  pbuf=pbuf||cr'   Daily limits           :'right_justify(MaxDaily,23)
  pbuf=pbuf||cr'   Session Limit          :'right_justify(SessBytes,23)||cr
  pbuf=pbuf||cr' Session Particulars'cr||arg(1)||cr
end
pbuf=pbuf||cr||cr||cr||"--- Shelter "app||cr||cr||"000000"x
if ~open('packet',packet_name,"W") then do;address LOGPROC 'PutLog 'LG time() Line MP "Couldn't open packet-file ["packet_name"]";return 20;end
call writech('packet',pbuf);call close('packet');drop pbuf
if ~sysrpt then call queueadd(packet_name,get_fn(packet_name),5)
return 0

get_path:
  pos=lastPos('/',arg(1))
  if pos=0 then pos=LastPos(':',arg(1))
return substr(arg(1),1,pos)

right_justify:
if length(arg(1))>arg(2) then return (right(arg(1),arg(2)))
else return (copies(" ",arg(2)-length(arg(1)))||arg(1))

queueadd:
file=upper(arg(1))
sendas=arg(2)
flags=arg(3)
if HYD then do
  Hbuf=Hbuf||file sendas||'0a'x
  return 0
end
WORK=NULL
QUERY.XQ_NAME=file
QUERY.XQ_SITE=xfq_site_object
WORK=XfqFindWork(QUERY)
if WORK=NULL then do
  if ~XfqAddWorkQuick(R_A,file,sendas,120,flags) then do
    address LOGPROC 'PutLog 'LG time() Line MP 'Queue 'file' Failed:'XFQERRORMSG R_A
    drop XFQERRORCODE XFQERRORMSG
  end;else do
    address LOGPROC 'PutLog 'LG time() Line MP 'Queued 'file' as' sendas
  end
end;else do
  call XfqUnlockWork(WORK)
  address LOGPROC 'PutLog 'LG time() Line MP file 'already queued'
end
if WORK~=NULL then call XfqDropObject(WORK)
return 0

get_fn:
if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
else return arg(1)

badsite:
address LOGPROC 'Putlog 'LG time() Line "Refusing Request! "arg(1)
LBUF=LBUF||date() time() Line' Refusing request from 'arg(3)' of 'arg(2)' -> 'arg(1)||lf
call writepkt('File request terminated: 'arg(1)||cr)
call end_session()
return 0

RspErr:
MBUF=MBUF||'Request Number 'arg(2) 'Requested: 'arg(3)||cr'Error: 'arg(1)||cr||cr
LBUF=LBUF||date() time()' 'FName.a' -=> Error: 'arg(1) arg(4)||lf
return

setconfig:
if ~open('cf',cfg,'r') then
 if ~open('cf',"RAM:RFH.cfg",'r') then
  if ~open('cf',"CFG:RFH.cfg",'r') then do;address LOGPROC 'PutLog 'LG time() Line 'Could not read RFH.cfg';exit;end
exidx=1;ixidx=1;lxidx=1;pxidx=1
do while ~eof('cf')
  lx=readln('cf')
  if lx="" | left(lx,1)=" " | left(lx,2)='/*' | left(lx,2)='*/' then iterate
  parse var lx vn vv junkcomment
  vn=upper(vn);vv=strip(vv)
  select
    when vn="PRIORITY" then priority=vv
    when vn="SYSOPREPORT" then SysopReport=vv=="TRUE"
    when vn="REQPOINT" then ReqPoint=vv=="TRUE"
    when vn="REQUNLISTED" then ReqUnListed=vv=="TRUE"
    when vn="SORTEDLST" then SortedLst=vv=="TRUE"
    when vn="MULTIMAGIC" then MultiMagic=vv=="TRUE"
    when vn="MATCHFIRST" then MatchFirst=vv=="TRUE"
    when vn="FREQLST" then SFreqLst=dequote(vv)
    when vn="PRIVLST" then PFreqLst=dequote(vv)
    when vn="LOGFILE" then LogFile=dequote(vv)
    when vn="ACCTPATH" then AcctPath=dequote(vv)
    when vn="EXCLUDE" then do
      EXCLUDE.exidx=translate(dequote(vv),"?","#")
      exidx=exidx+1
    end
    when vn="INCLUDE" then do
      INCLUDE.ixidx=translate(dequote(vv),"?","#")
      ixidx=ixidx+1
    end
    when vn="LIMITED" then do
      parse var junkcomment limit junkcomment
      LIMITED.lxidx=translate(dequote(vv),"?","#")' 'limit
      lxidx=lxidx+1
    end
    when vn="PRIVLEDGED" then do
      PRIVLEDGED.pxidx=translate(dequote(vv),"?","#")
      pxidx=pxidx+1
    end
    when vn="MAXBYTES" then MaxBytes=vv
    when vn="MAXDAILY" then MaxDaily=vv
    when vn="MAXREQNAMES" then MaxReqNames=vv
    otherwise address LOGPROC 'Putlog 'LG time() Line MP 'Config Error:'lx
  end
end
call close('cf')
if exidx>0 then EXCLUDE.0=exidx-1;else EXCLUDE.0=0
if ixidx>0 then INCLUDE.0=ixidx-1;else INCLUDE.0=0
if lxidx>0 then LIMITED.0=lxidx-1;else LIMITED.0=0
if pxidx>0 then PRIVLEDGED.0=pxidx-1;else PRIVLEDGED.0=0
if EXCLUDE.0>0 & INCLUDE.0>0 then address LOGPROC 'Putlog 'LG time() Line MP 'Config Error: Cannot BOTH INCLUDE and EXCLUDE sites'
drop lx vv vn junkcomment exidx ixidx lxidx
if Priority~=0 then oldpri=Pragma('Priority',Priority)
address LOGPROC 'Putlog 'LG time() Line MP 'Config loaded, Pri:'priority
return


showconfig:
address LOGPROC 'Putlog 'LG time() Line 'Configuration'
address LOGPROC 'Putlog 'LG time() Line 'Priority:'priority
address LOGPROC 'Putlog 'LG time() Line 'reqPoint:'reqpoint
address LOGPROC 'Putlog 'LG time() Line 'ReqUnlisted:'requnlisted
address LOGPROC 'Putlog 'LG time() Line 'SortedLst:'sortedlst
address LOGPROC 'Putlog 'LG time() Line 'MultiMagic:'multimagic
address LOGPROC 'Putlog 'LG time() Line 'MatchFirst:'matchfirst
address LOGPROC 'Putlog 'LG time() Line 'FREQLST:'sfreqlst
address LOGPROC 'Putlog 'LG time() Line 'PRIVLST:'pfreqlst
address LOGPROC 'Putlog 'LG time() Line 'Logfile:'logfile
address LOGPROC 'Putlog 'LG time() Line 'AcctPath:'acctpath
address LOGPROC 'Putlog 'LG time() Line 'MaxBytes:'maxbytes
address LOGPROC 'Putlog 'LG time() Line 'MaxDaily:'maxdaily
address LOGPROC 'Putlog 'LG time() Line 'MAxReqNames:'maxreqnames
address LOGPROC 'Putlog 'LG time() Line 'Excludes:'exclude.0
if exclude.0~=0 then do i=1 to exclude.0
address LOGPROC 'Putlog 'LG time() Line 'Excluded:'exclude.i
end
address LOGPROC 'Putlog 'LG time() Line 'Includes:'include.0
if include.0~=0 then do i=1 to include.0
address LOGPROC 'Putlog 'LG time() Line 'Included:'include.i
end
address LOGPROC 'Putlog 'LG time() Line 'Limited:'limited.0
if limited.0~=0 then do i=1 to limited.0
address LOGPROC 'Putlog 'LG time() Line 'Limited:'limited.i
end
address LOGPROC 'Putlog 'LG time() Line 'Privledged:'privledged.0
if privledged.0~=0 then do i=1 to privledged.0
address LOGPROC 'Putlog 'LG time() Line 'Privledged:'privledged.i
end
return


lower:
return(bitor(arg(1),'20'x))

Syntax: call template_oops "Syntax(RC="RC")" sigl
failure: call template_oops "Failure(RC="RC")" sigl
halt: call template_oops "Halt" sigl
template_oops:
parse arg what badline
address LOGPROC 'PutLog 'LG time() Line MP "ERROR "what" Line:"badline
call end_session()
exit

end_session:
x=XfqReleaseMailer(xfq_site_object)
call XfqDropObject(xfq_site_object)
if WORK~=NULL then call XfqDropObject(WORK)
call XfqClose()
if ABUF~="" then do
  address LOGPROC 'PutLog 'LG time() Line "Updating account"
  call open('Acct',AcctFile,'W')
  call Writech('Acct',ABUF||lf)
  call close('Acct')
  drop ABUF
end
LBUF=LBUF||date() time()' RFH session Ending'lf
if LogFile~="" then do
  if exists(LogFile) then call open('log',LogFile,'A');else call open('log',LogFile,'W')
  call writech('log',LBUF||lf);call close('log')
end;else do
  i=1
  loglen=length(LBUF)
  do while i < loglen+1
    alen=pos('0a'x, LBUF, i)-i
    aline=substr(body,i,alen)
    address LOGPROC 'PutLog 'LG Line aline
    i=i+alen+1
  end
  drop alen aline i
end
drop LBUF
call delete(infile)
address LOGPROC 'PutLog 'LG time() Line 'RFH session with' R_A 'terminated'
return 0

dequote:
parse arg thing
parse var thing '"' unq_thing '"'
if unq_thing ~= "" then return unq_thing
return thing